home *** CD-ROM | disk | FTP | other *** search
/ Technotools / Technotools (Chestnut CD-ROM)(1993).ISO / lang_oth / linpklib / sswap.for < prev    next >
Text File  |  1984-01-07  |  1KB  |  56 lines
  1.       SUBROUTINE SSWAP (N,SX,INCX,SY,INCY)
  2. C
  3. C     INTERCHANGES TWO VECTORS.
  4. C     USES UNROLLED LOOPS FOR INCREMENTS EQUAL TO 1.
  5. C     JACK DONGARRA, LINPACK, 3/11/78.
  6. C
  7.       REAL SX(1),SY(1),STEMP
  8.       INTEGER I,INCX,INCY,IX,IY,M,MP1,N
  9. C
  10.       IF(N.LE.0)RETURN
  11.       IF(INCX.EQ.1.AND.INCY.EQ.1)GO TO 20
  12. C
  13. C       CODE FOR UNEQUAL INCREMENTS OR EQUAL INCREMENTS NOT EQUAL
  14. C         TO 1
  15. C
  16.       IX = 1
  17.       IY = 1
  18.       IF(INCX.LT.0)IX = (-N+1)*INCX + 1
  19.       IF(INCY.LT.0)IY = (-N+1)*INCY + 1
  20.       DO 10 I = 1,N
  21.         STEMP = SX(IX)
  22.         SX(IX) = SY(IY)
  23.         SY(IY) = STEMP
  24.         IX = IX + INCX
  25.         IY = IY + INCY
  26.    10 CONTINUE
  27.       RETURN
  28. C
  29. C       CODE FOR BOTH INCREMENTS EQUAL TO 1
  30. C
  31. C
  32. C       CLEAN-UP LOOP
  33. C
  34.    20 M = MOD(N,3)
  35.       IF( M .EQ. 0 ) GO TO 40
  36.       DO 30 I = 1,M
  37.         STEMP = SX(I)
  38.         SX(I) = SY(I)
  39.         SY(I) = STEMP
  40.    30 CONTINUE
  41.       IF( N .LT. 3 ) RETURN
  42.    40 MP1 = M + 1
  43.       DO 50 I = MP1,N,3
  44.         STEMP = SX(I)
  45.         SX(I) = SY(I)
  46.         SY(I) = STEMP
  47.         STEMP = SX(I + 1)
  48.         SX(I + 1) = SY(I + 1)
  49.         SY(I + 1) = STEMP
  50.         STEMP = SX(I + 2)
  51.         SX(I + 2) = SY(I + 2)
  52.         SY(I + 2) = STEMP
  53.    50 CONTINUE
  54.       RETURN
  55.       END
  56.